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/// Forever !!! 



t Apple /// Computer Information 



Calendar Program in /// Business BASIC 
by Paul Irwin (1980) 



Compiled by 
David T. Craig 
736 Edgewater, Wichita, Kansas 67230 




NEU 

100 
200 
3000 
3004 
3005 
3010 
30H 
3020 
3990 
5000 
5004 
5020 
5030 
5040 
5050 
5060 
5070 
5080 
5090 
5100 
5110 
5120 
5130 
5140 
5200 
5300 
5310 
5320 



GOTO 30000 

REI1 ** SET UIND0H ** 

REH *** CHOICE OF flONTH *** 

PR I NT CHR$ (16); CHR$ ( 1 ) ; CHR$ (19); CHR$ ( ) ; CHR$ ( 20 ) ; CHR$ ( 1 5 ) 
UP0S=20:HP0S=1 

UIN00U 0,0 TO 40,15:H0nE:IHPUT"T»o Numbers : WW, mi)? ";Y,M 
IF V>1581 RND 11>0 RHD H<13 THEN 3990 
PRINT"Pardon?";CHR$(7):G0T0 3010 
RETURN 

REH *** DISPLRV MONTH *** 

PRINT CHR$( 16) WINDOW 0,0 TO 40,15:H0t1E 

VV=INT(V-1):nn=INT(N+10):IF fffl<13 THEN 5040 

nn=nn-i2:W=vv+i 

DD=INT(D0+F0(nn)+INT(VV/4)+INT(VV/400)-INT(VV/100)+VV) 

DD= I NT ( 1 . 000 1 +DD-7* I NT ( DD/7 ) ) 

UP0S=4 : HP0S=17-LEN(n0$(NN) )/2 

PRINT H0$(fH1)j", ";V 

UP0S=8:HP0S=6 

PRINT"SUN HON TUE WED THR FRI SRT" 

IF IW<12 THEN 5200 

LRST=28 

IF INT(Y-4*INT(Y/4))=0 RND INT(Y-100*INT(Y/100))<>0 THEN LflST=29 
IF I NT ( V-400* I MT ( V/400 ) ) =0 THEN LRST=29 
GOTO 5300 

LRST=F0(nn+i)-F0(nn) 

FIRST=DD:D1=1 

FOR UEEK=1 TO 6:UP0S=9+UEEK:F0R DflV=1 TO 7:HP0S=4*DflV+2 
IF D1=1 RND DflV<F I RST THEN 5360 
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5330 IF D1 >LflST THEN 5360 

5310 IF DK10 THEM PRINT CHR$(32); 

5350 PRINT D1;:01=D1+1 

5360 NEXT; NEXT 

5375 PRINT CHR$(16) 

5990 RETURN 

6000 REN **** BUILD 3 MONTHS **** 

6001 REN USED 8Y PRINTER 

6002 REN 

6010 FOR 1=1 TO ?:LINE$(l)="":F0R J=1 TO 80:LINE$( I )=LINE$( I )+CHR$(32) 

6015 NEXT:X= FREiNEXT 

6020 FOR N1=1 TO 3:N=3*R+r11 

6030 VV=INT(V-1):Nn=INT(n+10):IF t1N<13 THEN 6050 

6010 rni=Nf1-12:VY=VV+1 

6050 DD=INT(D0+F0(nn)+INT(VV/1)+INT(VV/1OO)-INT(VV/100)+YV) 

6060 0D=INT(1 . 0001 +DD-?* I HT(DD/7) ) 

6070 ZZ$=LEFT$(LI$(7) J T(m))+N0$(nn) 

6080 IF HN<12 THEN 6120 

6090 LRST=28:IF INT(Y-1*INT(Y/1))=0 AND I HT( V-1 00* I HT( V/t 00) )<>0 THEN 

LRST=29 

6110 GOTO 6200 

6120 LRST=F0<nn+i)-F0(nn) 

6200 FIRST=DD:D1=1 

6210 FOR UEEK=1 TO 6: FOR DRY=1 TO 7 

6220 IF D1 =1 AND DRY< FIRST THEN 6290 

6230 IF D1 >LRST THEN 6290 

6210 fl$=STR$(D1) 

6250 ZZ$=LEFT$(LI NE$(UEEK) , T(N1 )+3*DRY-LEN(fl$) )+fl$ 

6255 L I NE$(UEEK)=ZZ$+R I GHT$(L I HE$(UEEK) , LEN(L I NE$(UEEK) )-T(N1 )-3*DRY) 

6260 D1=DM 

6290 NEXT 
6292 NEXT 

6291 NEXT N1 
6990 RETURN 

21000 REM **** SCREEN NENU **** 

21010 TEXT: HONE: PR I NT CHR$(16) 

21020 INUERSE:UP0S=1 :HP0S=1 :FOR 1=1 TO 39 : PR I HT CHR$(32); :NEXT 

21030 FOR 1=1 TO 18:UP0S=I :HP0S=1 : PRINT CHR$(32); :HP0S=39:PRINT 
CHR$(32);:NEXT 

21010 UP0S=18:HP0S=1:F0R 1=1 TO 39:PRINT CHR$(32); :NEXT 

21050 NORURL 
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21060 GOSUB 3000 :REH CHOICE 

21070 GOSUB 5000; REM DISPLflV MONTH 

21000 UP0S=23:T=6:PRIHT CHR$(16) 

21005 UIHDOU 0,17 TO 80, 25: HOME 

21090 PR i HT : PR t HT : HP0S=T : PR I HT" <LEFT> ... LAST MONTH" 

21100 HPOS=T:PRIHT"<RIGHT> ... NEXT MONTH" 

21110 HPOS=T:PRIHT"<SPRCE> ... ANOTHER CHOICE" 

21120 HPOS=T:PRINT" <RTN> ... RETURN TO tIENU" 

21130 PRINT CHR$(16):UIND0U 1,1 TO 39,21 

21150 UP0S=23:HP0S=1:GET R$ 

21160 IF R$<>CHR$(8) THEN 21180 

21170 H=M-1:IF f1>=1 THEN 21171 
21172 f1=12:Y=Y-1 

21171 GOSUB 5000:PRINT CHR$(16) :GOTO 21150 

21180 IF R$<>CHR$(21) THEN 21190 
21182 11=11+1 : IF N<13 THEN 21186 

21181 M=1:Y=Y+1 

21186 GOSUB 5000: GOTO 21150 

21190 IF fl$<>CHR$(32) THEN 21210 

21200 GOSUB 3000 :REH CHOICE 
21202 GOSUB 5000: REN OISPLRY (10NTH 

21201 GOTO 21150 

21210 IF R$=CHR$(13) THEN 21900 

21220 GOTO 21 150: REN IGNORE 

21900 RETURN 

22000 REN **** PRINTER NENU **** 

22002 PRINT"OTTRUR 6502 USER GROUP -- POB 6283 STN J — OTTRUR ~ KIP 5R3" 

22010 TEXT: HONE: PR I NT CHR$(16) 

22015 UP0S=6 

22020 INPUT "PR INTER SLOT? (1-1) "jSLOT 

22030 IF SL0T<1 OR SLOTH THEN PRINT CHR$ ( 7 ) ; " PRRDON? " : GOTO 22020 

22010 PR I NT: PR I NT 

22050 INPUrUHICH YERR?(YYYY) : ";Y0$ 
22052 IF LEN(Y0$)<>1 THEN 22050 

22051 Y 1 =URL ( LEFTS < Y0$ , 1 ) ) : Y2=URL ( M I D$ ( Y0$ , 2 , 1 ) ) : Y3=URL ( M I D$ ( Y0$ , 3 , 1 ) ) 

22055 Y1=URL(R!GHT$(Y0$,1)) 

22056 Y=URL(YO$) 

22060 IF Y<1582 OR Y>2999 THEN PRINT CHR$(7) ; "PRRDON?" : GOTO 22050 
22062 PRINT 

22061 INPUT-HOU NRNY COP I ES?( 1 -20) : ";NCX:IF HCX< 1 OR NCS>20 THEN 22062 
22066 PR I NT: PR I NT 
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22070 


PRINT "START UP THE PRINTER, THEN" 




22080 


PR INT "PRESS A KEY ";:GETA$ 




22090 


PR 1 NT : PR 1 NT : HP0S= 1 5 : PR 1 NT " . . . STANDBY 


« 


22100 


PRINT :PRIHT:PRIHT 




22200 


0PEH«SL0T /.SI LEHTYPE" : 0UTPUT«SL0T 




22201 


PRINT 




22210 


FOR CN=1 TO NCX 




22220 


PRINT CHR$(32) 




22222 


PRINT CHR$(32) 




22221 


FOR L=1 TO 7 




22226 


FOR 1=1 TO 20;PRINT CHR$(32); :NEXT 




22228 


PRINT Y$(L,Y1+1)/ ";Y$(L,Y2+D/ 


";Y$(L,Y3+1)/ 




";Y$(L,Y1*1) 




22230 


NEXT 




22232 


PRINT CHR$(32):PRINT CHR$(32) 




22231 


PRINT CHR$(32) 




22210 


FOR H=0 TO 3 




22250 


GOSUB 6010 




22260 


PRINT LINE$(7) 




22261 


PRINT no$ 




22262 


A$="S 11 T U T F S" 




22261 


PRINT" ";R$/ "jA$/ 


";R$ 


22270 


FOR 1=1 TO 6:PRINT LINE$( 1 ) :NEXT 




22280 


FOR 1=1 TO 3: PR INT CHR$(32) :NEXT 




22290 


NEXT R 




22291 


PRINT"«< HAUE R GREAT YEAR! »>" 




22292 


PRINT"OTTAUA 6502 USER GROUP ~ POB 6283 STN J — OTTRUR — K2R 1T3" 


22300 


FOR 1=1 TO 8:PRINT CHR$(32) :NEXT 




22100 


NEXT CN 




22500 


OUTPUT«0 




22990 


RETURN 




30000 


REN **** CONSTANTS **** 




30010 


D0=3:REN PHASE DAY OF WEEK 




30050 


REN START THE YERR ON fIRRCH FIRST RND 


TABLE THE 


30052 


REN FIRST DAY OF EACH NONTH. THIS UORKS UHEN 


30051 


REN FEBRUARY IS THE LAST NONTH OF THE 


YEAR! 


30100 


DIN F0(12):DATA 0,31,61,92,122,153/81,211,215,275,306,337 


30105 


FOR 1=1 TO 1 2 : RERD FO(l):NEXT 




30106 


DIN nO$(12):nO$(1)="nARCH":n0$(2)="APRIL B :N0$(3)="NRY":n0$(1)="JUNE" 


:r!0$(5)= 


="JULY" :N0$(6)="AUGUST" :N0$(7)="SEPTEI1BER" :N0$(8)="0CT0BER" :I10$(9)= 


"N0UEHBER" : H0$(10)="DECEf1BER" : H0$( 1 1 )= "JANUARY" : f10$( 1 2)="FEBURRY" 
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30H0 


Dlfl LIHE$(7) 


30150 


Dill T(3):T(1)=1 :T(2)=28:T(3)=55 


30200 


REtt ZERO 


30201 


DRTR " **** " 


30202 


DRTR "** **" 


30203 


DRTR "** **" 


30201 


DRTR "** **" 


30205 


DRTR "** **" 


30206 


DRTR "** **" 


3020? 


DRTR " **** " 


30210 


REtt ONE 


30211 


DRTR " ** " 


30212 


DRTR " *** " 


30213 


DRTR " ** " 


302 M 


DRTR " ** " 


30215 


DRTR " ** " 


30216 


DRTR " ** " 


30217 


DRTR " **** " 


30220 


REO TUO 


30221 


DRTR " **** " 


30222 


DRTR "** **" 


30223 


DRTR "** **" 


30221 


DRTR " ** " 


30225 


DRTR ** 


30226 


DRTR "** 


30227 


DRTR "****♦*" 


30230 


REM THREE 


30231 


DRTR " **** " 


30232 


DRTR "** **" 


30233 


DRTR " **" 


30231 


DRTR " ** " 


30235 


DRTR " **" 


30236 


DRTR "** **" 


30237 


DRTR M **** " 


30210 


RErt FOUR 


30211 


DRTR " ** " 


30212 


DRTR " *** " 


30213 


DRTR " * ** " 


30211 


DRTR "***♦**" 


30215 


DRTR " ** " 


30216 


DRTR " ** " 
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30217 


DflTfl 


■ ** » 


30250 


REfl FIUE 


30251 


DRTR 


■He****** 


30252 


DRTR 


"** " 


30253 


DRTR 


"** ■ 


30251 


DflTfl 


«****« » 


30255 


DflTfl 


" **" 


30256 


DRTR 


»** **» 


30257 


DRTR 


■ **** « 


30260 


REfl SIX 


30261 


DflTfl 


" **** » 


30262 


DATA 


"** **» 


30263 


DRTR 


"** " 


30261 


DRTR 


****** « 


30265 


DRTR 


«** **■ 


30266 


DflTfl 


"** **» 


30267 


DRTR 


" **** « 


30270 


REI1 SEUEN 


30271 


DflTfl 




30272 


DflTfl 


••* **" 


30273 


DRTR 


" ** ■ 


30271 


DRTR 


" ** " 


30275 


DRTR 


■ ** ■ 


30276 


DRTR 


"** u 


30277 


DflTfl 


«** « 


30280 


REM E 


IGHT 


30281 


DflTfl 


■ **** ■ 


30282 


DflTfl 


■** **■ 


30283 


DflTfl 


"** **» 


30281 


DRTR 


« **** « 


30285 


DflTfl 


■** **» 


30286 


DATA 


»** **" 


30287 


DATA 


" **** » 


A A A A A 

30290 


REH NINE 


30291 


DRTR 


» **** « 


30292 


DRTR 


»** **« 


30293 


DRTR 


■** **■ 


30291 


DRTR 


« **** •> 


30295 


DATA 


« ** H 


30296 


DflTfl 




30297 


DflTfl 


»** " 
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30300 


DIM Y$(7,10) 


30310 


FOR 1=1 TO 10 


30320 


FOR J=1 TO 7: READ V$(J, 1 ) : NEXT 


30330 


NEXT 


30990 


REN 


30992 


REN 


31000 


REN **** Nfl INLINE NENU **** 


31010 


TEXT: HONE: PR INT CHR$(16);CHR$(1 ) 


31020 


UP0S=3 : HP0S=1 6 : PR 1 NT"CRLENDRR" 


31022 


PRINT:HP0S=6 


31030 


T=10:UP0S=7 


31010 


HP0S=2:PRINT"R Perpetual Calendar program for":PRINT 


31050 


PRINT"your choice of Screen or Printer:" 


31060 


PR 1 MT : PR 1 HT : HP0S=T : PR 1 HT"S ... Screen" 


31070 


PR 1 HT : PR 1 MT : HP0S=T : PR 1 HT"P ... Printer" 


31060 


PR 1 HT : PR 1 HT : HP0S=T--t : PR 1 MT " < RTH > ... Return to nenu" 


31120 


X= FRE 


31130 


UP0S=23:HP0S=15:PRINT"Uhich? " j : GET A$ 


31110 


IF A$<>"S" THEN 31160 


31150 


GOSUB 21 000: GOTO 31010 


31160 


IF A$o"P" THEN 31180 


31170 


GOSUB 22000: GOTO 31010 


31180 


IF A$<>CHR$(13) THEN 31130 


32000 


TEXT:HQNE:UP0S=12:HPQS=9 


32010 


PRINT-CRLENOAA IS OFF THE AIR" 


32020 


UP0S=23 


10000 


REN ***** CALENDAR ***** 


10001 


REn * WRITTEN 1980 BY * 


10002 


REN * PAUL IRUIN * 


10003 


REN * (613) 728-6728 * 


10001 


REII ******************** 


10005 


REN DOUNLOADED FRON 


lUUUU 


ntll HnL 1 linnllHNU o 


10007 


REN "RPPLE CITY" 


10008 


REN SOURCE «: TCD912 


10009 


p£n ******************** 


SflUE CALENDAR 
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